COMMENT ⊗   VALID 00015 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	Definitions.
C00007 00003	Flag definitions and storage allocations.
C00012 00004	Start of main program (DOER).  Prepare to read in uncataloged story from 'NEWS' file.
C00017 00005	Read in undun story.  Check sequence nbr for digest, etc.
C00021 00006	For each word in story, collect its letters.
C00024 00007	Check current word for indicator of a correction, an add, or a take.
C00030 00008	Find appropriate place in sorted list for current word.
C00034 00009	Open INDEX and DICT files.  Read in WORDS and LINKS files.
C00036 00010	Look for keywords in story.  Link up any that are found.
C00039 00011	Link up keyword in story.
C00045 00012	Write out new versions of files.
C00050 00013	Subroutines:  RDDICT, GTDICT, PAUSE1-4, DIGEST, DONTDO, GONE.
C00055 00014	Subroutines: UUCODE.
C00060 00015	Interrupt level module: INTRPT, CHGNAM.
C00065 ENDMK
C⊗;
;Definitions.
	TITLE	DOER
EXTERNAL JOBAPR,JOBCNI
;     ACCUMULATOR ASSIGNMENTS
F←←0			;contains flags in LH and "@" (octal 100) in RH
A←1			;temporary AC
B←2			;temporary AC
C←3			;temporary AC
AVAIL←←3		;pointer to an available link block in LINKS
WD←4			;the word being looked at in the sorted list
PREV←←4
D←4			;AC for the number of a detected error
DICTWD←5		;pointer to the current dictionary entry
FIRST←6			;ptr to text of current dictionary word
AC1←←7			;temporary AC
AC2←←10			;temporary AC
SORPTR←7		;pointer to current entry in the sorted list (SORDID)
TXTPTR←10		;byte pointer for depositing letters into TEXT area
PART1←←11		;four ac's for holding the (possible) 4 words per
PART2←←12		;	entry in the sorted list. Used in comparison.
PART3←←13
PART4←←14
CHAR←11			;current character of story
DISPL←12
SIZE←13
BPTR←15			;byte pointer into buffer holding current story
LWD←16			;the last word looked at in the sorted list
P←17

LF←←12  CR←←15

NKEYS←←=20		;max nbr of keywords all starting with same word
PDLEN←←=30		;length of push down list

SPECS←←4		;number of special words at front of INDEX file
XSIZE←←3		;size of the index entry for one story
MAXNBR←←=500		;maximum number of stories allowed
XLEN←MAXNBR*XSIZE+SPECS	;total size of space for index entries
LLEN←←10000
WLEN←←6400

DEFINE UNDUN {INDEX}	;first word in INDEX file
DEFINE NEW {INDEX+1}	;second word
DEFINE OLD {INDEX+2}	;third word

	LOC	41
	JSR	UUCODE
	LOC

OPDEF	UEXIT	[001000,,];minor error. swap in new version of DOER
OPDEF	UERROR	[002000,,];moderate error. write message in ERRORS file and swap
OPDEF	UBIGERR	[003000,,];horrendous error. write message in ERRORS file
;Flag definitions and storage allocations.

;LEFT HALF FLAGS (AC 0)
LESS  ← 400000	; used when looking for an earlier story with given seq nbr
WRFLAG← 200000	; 1 if the DICREC must be written out
MISSIN← 100000	; 1 if story sought in NEWS was not found
TAKEFG←← 40000	; 1 if current story is a TAKE
CATFLG←← 20000	; 1 if current word has been used to categorize the story

NEWSF:	SIXBIT	/NEWS/	;block for LOOKUP and ENTER for NEWS file
	BLOCK	3
INDEXF:	SIXBIT	/INDEX/	;block for LOOKUP and ENTER for INDEX file
	BLOCK	3
LINKSF: SIXBIT	/LINKS/	;block for LOOKUP and ENTER for LINKS file
	BLOCK	3
DICTF:	SIXBIT	/DICT/	;block for LOOKUP and ENTER for DICT file
	BLOCK	3
WORDSF:	SIXBIT	/WORDS/	;block for LOOKUP for WORDS file
	BLOCK	3
ERRORF:	SIXBIT	/ERRORS/;block for LOOKUP and ENTER for ERRORS file
	BLOCK	3
BUF:			;buffer to hold part of ERRORS file is same as STORY buffer
STORY:	BLOCK	2200	;buffer to hold stories
INDEX:	BLOCK	XLEN	;core array for holding index pointers for stories
LINKS:	BLOCK	LLEN	;holds the assorted relationships for words found in DICT
DICT:	BLOCK	400	;holds two records of the dictionary, 1 reg and 1 mults
WORDS:	BLOCK	WLEN	;holds the words actually pointed to in DICT
SORDID:	BLOCK	=600	;holds the sorted list of words in a story
TEXT:	BLOCK	=1500	;holds the characters of the words in the story
PDLIST:	BLOCK	PDLEN	;push down list
KEYS:	BLOCK	NKEYS	;ptrs to dictionary entries for keywords categorizing story

CMD:	IOWD	1,STORY		;command for reading in a story to be cataloged
	0
XCMD:	IOWD	XLEN,INDEX	;command for reading/writing INDEX
	0
LCMD:	IOWD	LLEN,LINKS	;command for reading/writing LINKS
	0
DCMD:	IOWD	200,DICT	;command for reading/writing DICT
	0
MCMD:	IOWD	200,DICT+200	;command for reading/writing a mult rec of DICT
	0
WCMD:	IOWD	WLEN,WORDS	;command for reading WORDS
	0

DSK17:	217			;block for OPENing the DSK in mode 17 many times
	SIXBIT	/DSK/		;200 bit means take error return automatically
	0			;	if DISK IS FULL or BAD RETRIEVAL
SWAPBK:	SIXBIT	/DSK/
	SIXBIT	/DOER/
	SIXBIT	/DMP/
	1			;start at 1 past normal starting address
	SIXBIT	/ APSYS/

NAME:	SIXBIT	/[DOER]/	;name DOER uses while running
WRDCNT:	0
DICPTR:	0			;pointer to the current dictionary entry
DICREC:	0			;number of the current record of DICT that is in core
MLTPTR:	0			;negated ptr to DICT entry for current mult word key
MLTREC:	0			;number of the current mult rec of DICT that is in core
GUDREC:	0			;number of current mult rec that needs to be in core
LKOVFL:	0			;LINKS space overflow flag
LOSEQ:	0			;lowest acceptable seq nbr for earlier take
HISEQ:	0			;highest acceptable seq nbr for earlier take
SPBPTR:	0			;special byte ptr
NRDOER:	0			;code indicating number of other DOERs
TTYLIN:	0			;word for indicating whether DOER is detached
STCNT:	0		;word for number of stories we have yet to look for earlier take
LEN:	0			;pseudo length of a story word
CHCNT:	0			;character count for the UNDUN story
CATNBR:	0			;nbr of similar keywords categorizing story
;Start of main program (DOER).  Prepare to read in uncataloged story from 'NEWS' file.

DOER:	SKIPA			;normal starting address leaves RESTART = 0
	SETOM	RESTAR#		;if swapped in by self, set RESTAR = -1
	MOVEI	F,"@"		;clear all flags in LH, and load "@" in RH
	MOVEI	A,INTRPT	;get address of interrupt level module
	MOVEM	A,JOBAPR	;store it in JOBAPR
	MOVE	A,[400200000]	;enable for interrupts on parity errors and
	CALL	A,[SIXBIT /INTENB/];	pdl ov
	MOVEI	A,200000
	CALL	A,[SIXBIT /INTGEN/];generate a pdl ov interrupt to set the job name
	MOVE	A,NRDOER	;get code nbr indicating number of other DOERs
	JRST	.+2(A)
	UBIGERR	4	;	;ONE OTHER DOER ALREADY EXISTS!
	UBIGERR	10	;	;TWO OR MORE DOERS ALREADY EXIST!
	
AGAIN3:	OPEN	1,DSK17		;get the index file
	UERROR	14	;	;OPEN FAILED ON DSK
	SETZM	INDEXF+3
	LOOKUP	1,INDEXF	;INDEX file
	JRST	PAUSE3
	IN	1,XCMD		;read in INDEX file
	JRST	.+2
	UERROR	20	;	;IN UUO FAILED TO READ IN INDEX FILE
	RELEAS	1,		;INDEX file
	MOVE	P,[INITPD: IOWD PDLEN,PDLIST];init the stack ptr
	MOVE	B,UNDUN		;grab UNDUN from the INDEX file
MORE:	CAMN	B,NEW		;has UNDUN caught up with NEW?
	CALL	[SIXBIT /EXIT/]	;yes. exit (releasing the job since jlog is probably not set)
;check if UNDUN points to a story that has been deleted or otherwise wiped out
DOMORE:	MOVE	A,OLD		;get index of OLD story and compare with
	CAMG	A,NEW		;	index of NEW area
	JRST	OLDLES		;OLD index is above (less than) NEW index
	CAML	B,NEW		;NEW index is above (less than) OLD index.
	CAML	B,OLD		;is UNDUN between OLD and NEW?
	JRST	DOMOR1		;no.  everything is ok.
OLDUN:	MOVEM	A,UNDUN		;make the oldest story the first undun one
	MOVE	B,A
	JRST	DOMOR1
OLDLES:	CAML	B,OLD		;OLD index is above (less than) NEW index
	CAML	B,NEW		;is UNDUN between OLD and NEW?
	JRST	OLDUN		;no! UNDUN story seems to have been deleted (or something)
;calculate the size of the UNDUN story using its position and that of the next story
DOMOR1:	MOVE	SIZE,B
	ADDI	SIZE,XSIZE
	CAIL	SIZE,XLEN
	MOVEI	SIZE,SPECS
	MOVN	SIZE,INDEX+1(SIZE)
	ADD	SIZE,INDEX+1(B)
	JUMPL	SIZE,ONWARD
DOWN:	MOVN	SIZE,INDEX+3	;UNDUN story is last in NEWS. get ptr to end of NEWS
	ADD	SIZE,INDEX+1(B)
ONWARD:	ASH	SIZE,-13	;right adjust the negated size of the UNDUN story
	OUTSTR	[ASCIZ / STORY! /]
	HRRZ	DISPL,INDEX+1(B);get displacement of UNDUN story
	ASH	DISPL,-13	;right-adjust displacement
	MOVN	A,DISPL		;make displacement negative (size is already negative)
	ADD	A,SIZE		;calculate length of NEWS stuff to be read in
	HRLM	A,CMD		;put length in the command word
	SETZM	LINKS+1		;clear the back ptr to slots for this story
	TLZ	F,TAKEFG+MISSIN	;clear these two flags
;Read in undun story.  Check sequence nbr for digest, etc.

AGAIN1:	OPEN	0,DSK17		;prepare to read the NEWS file
	UERROR	24	;	;OPEN FAILED ON DSK
	SETZM	NEWSF+3
	LOOKUP	0,NEWSF		;NEWS file
	JRST	PAUSE1		;can't read NEWS...FILER is writing it
	HLRZ	A,INDEX+1(B)	;get record number for UNDUN story
	USETI	0,(A)
	IN	0,CMD		;input the UNDUN story into STORY
	JRST	.+2
	UERROR	30	;	;IN UUO FAILED TO READ IN NEWS STORY
	RELEAS	0,		;NEWS file
	MOVEI	BPTR,STORY-1(DISPL)	;point byte pointer at first word of story
	HRLI	BPTR,700	;initialize byte pointer
	MOVE	TXTPTR,[POINT 7,TEXT-1,34]  ;initialize byte ptr to start of TEXT
	MOVE	A,SIZE		;put number of chars in story into CNT by
	ASH	A,2		;	multiplying size by 5
	ADD	A,SIZE
	MOVEM	A,CHCNT		;store number of chars
	MOVEI	SORPTR,1	;initialize SORPTR to start of SORDID
	MOVEI	B,3		;prepare to look for 3 digits of sequence nbr
	SETZ	C,
NEXTDG:	ILDB	A,BPTR		;get a char from first word of story
	CAIG	A,"9"		;is it a digit?
	CAIGE	A,"0"
	JRST	GONE		;no!
	IMULI	C,=10		;yes.  multiply sum of previous digits by =10
	ADDI	C,-60(A)	;add in current digit
	SOJG	B,NEXTDG	;got all 3 digits of seq nbr?
	ILDB	A,BPTR		;yes. get char after the 3 digits
	CAIE	A,CR		;does CR follow the digits?
	JRST	GONE		;no!
	ILDB	A,BPTR		;yes
	CAIE	A,LF		;does LF follow the CR?
	JRST	GONE		;no!
	MOVE	B,UNDUN
	HRRZ	A,INDEX+2(B)	;GET SUPPOSED SEQ NBR OF STORY
	CAME	C,A		;DOES STORY IN NEWS HAVE CORRECT SEQ NBR?
	JRST	GONE		;NO!
	MOVEM	C,HISEQ		;SAVE SEQ NBR OF CURRENT STORY
	JUMPE	C,DONTDO	;dont categorize stories 000 and 001
	CAIN	C,1
	JRST	DONTDO
	CAIE	C,=200		;dont categorize stories 200 and 201
	CAIN	C,=201
	JRST	DONTDO
	CAIE	C,2		;is this the PMS digest (story 002)?
	CAIN	C,=202		;is this the AMS digest (story 202)?
	JRST	DIGEST		;yes to one of these
;For each word in story, collect its letters.

	MOVEI	A,=45		;number of words at the front of the story that
	MOVEM	A,WRDCNT	;	are checked for special meanings
	SETZM	SORDID		;zero the header for the sorted list
BETW:	AOSLE	CHCNT		;begin reading characters until a letter is hit or
	JRST	READ		;	there are no more characters
	ILDB	CHAR,BPTR	;get next character from story
	CAIL	CHAR,"A"
	JRST	LTR
	CAIL	CHAR,"0"	;character is not a letter
	CAILE	CHAR,"9"	;is it a digit?
	JRST	BETW		;no
	JRST	CONT		;yes
LTR2:	TRZ	CHAR,40		;make all letters upper case
	JRST	MIDDL
LTR:	TRZ	CHAR,40		;make all letters upper case
CONT:	MOVEM	TXTPTR,SORDID(SORPTR);store byte ptr to TEXT of this new word
MIDDL:	IDPB	CHAR,TXTPTR	;deposit this letter in TEXT
	AOSLE	CHCNT		;any more chars in story?
	JRST	DEP100		;no
	ILDB	CHAR,BPTR	;yes, get one
	CAIL	CHAR,"A"
	JRST	LTR2		;it's a letter
	CAIGE	CHAR,"0"	;it's not a letter
	JRST	DEP100		;nor a digit
	CAIG	CHAR,"9"
	JRST	MIDDL		;it is a digit and the word goes on
DEP100:	IDPB	F,TXTPTR	;end of word...fill out text word with @'s
	TLNE	TXTPTR,760000
	JRST	DEP100
	HRRZ	A,SORDID(SORPTR);get ptr to beginning of current word
	MOVE	PART1,1(A)	;move word to PARTS for comparison for sorting
	MOVE	PART2,2(A)
	MOVE	PART3,3(A)
	MOVE	PART4,4(A)
;Check current word for indicator of a correction, an add, or a take.

	SOSGE	WRDCNT			;is current word among first words of story?
	JRST	ON			;no
	CAMN	PART1,[ASCII /TAKES/]	;is story the first of several takes?
	JRST	[TLO  F,TAKEFG		;yes.  mark it so
		 JRST ON]
	CAMN	PART1,[ASCII /TAKE@/]	;is story possibly a take of an earlier story?
	JRST	TAKE			;yes
	TDNE	PART1,[372010040000]	;is current word possibly a seq nbr?
	JRST	ON			;no
	SETCA	PART1,			;yes
	TDNE	PART1,[405406030000]	;check appropriate bits for 1's
	JRST	[SETCA	PART1,		;not a seq nbr.  re-complement PART1 back
		 JRST	ON]		;	to normal and go on
	SETCA	PART1,
;is a seq nbr.
	LDB	B,[POINT 7,PART1,13]	;AC B WILL HOLD THE REFERENCED SEQ NBR IN BINARY
	SUBI	B,60			;CONVERT 1ST DIGIT TO BINARY FROM ASCII
	IMULI	B,=10
	LDB	C,[POINT 7,PART1,20]
	ADDI	B,-60(C)		;ADD IN 2ND DIGIT OF SEQ NBR
	IMULI	B,=10
	LDB	C,[POINT 7,PART1,27]
	ADDI	B,-60(C)		;ADD IN 3RD DIGIT OF SEQ NBR

	MOVE	PREV,UNDUN		;prepare to look up index entry for prev story
	TLZ	F,LESS
	CAMGE	B,HISEQ			;does earlier story have smaller seq nbr?
TURNON:	TLO	F,LESS			;yes
NXPREV:	CAMN	PREV,OLD		;have we gotten back to oldest story?
	JRST	ON			;yes.  give up search
	SUBI	PREV,XSIZE		;no.  get index of the previous story
	CAIGE	PREV,SPECS
	MOVEI	PREV,XLEN-XSIZE
	HRRZ	C,INDEX+2(PREV)		;GET SEQ NBR OF THIS PREVIOUS STORY
	CAMN	B,C			;IS THE PREV STORY THE ONE REFERRED TO?
	JRST	LINKEM			;yes!
	CAIGE	B,=500			;is current story a special story?
	CAIL	C,=500			;is prev story a special story?
	JRST	NXPREV			;one of them is. dont make termination test
	CAMG	B,C			;have we passed seq nbr of desired story?
	JRST	TURNON			;no.  we are headed for it now
	TLNN	F,LESS			;yes.  were we ever headed for it?
	JRST	NXPREV			;no.  keep searching
	JRST	ON			;yes.  give up the search

LINKEM:	OPEN	7,DSK17			;grab INDEX file
	UERROR	34	;	;OPEN FAILED ON DSK
	SETZM	INDEXF+1
	SETZM	INDEXF+2
	SETZM	INDEXF+3
	ENTER	7,INDEXF
	JRST	[RELEAS 7,
		 MOVEI	A,2
		 CALL	A,[SIXBIT /SLEEP/]
		 JRST	LINKEM]
	JRST	FINISH
TAKE:	MOVEM	BPTR,SPBPTR		;copy the (byte) ptr into the story
TAK1:	ILDB	CHAR,SPBPTR		;get next char from story
	CAIN	CHAR,"t"		;is it a "t" (as in "two")?
	JRST	TAK9
	CAIL	CHAR,"A"		;is it a letter?
	JRST	ON
	CAIL	CHAR,"0"		;no.
	CAILE	CHAR,"9"		;is it a digit?
	JRST	TAK1			;no.  get next char
TAK9:	MOVE	PREV,UNDUN		;yes.  we have, eg: take 2
	TLO	F,TAKEFG		;set take flag in case cant find original take
	HRREI	A,-6			;number of stories back we are willing
	MOVEM	A,STCNT			;	to look for the earlier take
	ADD	A,HISEQ
	MOVEM	A,LOSEQ			;SAVE MIN SEQ NBR WE CAN ACCEPT FOR EARLIER TAKE
TAK8:	SUBI	PREV,XSIZE		;get index of the previous story
	CAIGE	PREV,SPECS		;	so that we can link current
	MOVEI	PREV,XLEN-XSIZE		;	story with the previous one,
	HRRZ	A,INDEX+2(PREV)		;	which should be an earlier
	CAML	A,LOSEQ			;	take of the same story.
	CAMLE	A,HISEQ			;IS SEQ NBR OF THIS PREV STORY IN RIGHT RANGE?
	JRST	GETNXT			;NO.  GET NEXT PREV STORY.
	HRRE	C,INDEX(PREV)		;YES.  IS THIS PREV STORY A TAKE?
	AOJE	C,LINKEM		;IF SO, LINK UP TO THE CURRENT STORY
GETNXT:	AOSGE	STCNT			;HAVE WE EXAMINED LIMIT OF PREV STORIES?
	JRST	TAK8			;NO.  TRY THE NEXT PREV STORY.
;Find appropriate place in sorted list for current word.

ON:	MOVE	A,SORDID(SORPTR);retrieve byte ptr into TEXT for current word
	SUB	A,TXTPTR	;get length of word
	HRLM	A,SORDID(SORPTR);save length of this word
	CAMGE	A,[-4]		;is word longer than 20 letters?
	HRREI	A,-4		;yes.  ignore all but first 20 letters
	MOVEM	A,LEN		;save pseudo length of this word (max = 4)
	SETZ	LWD,		;LWD points to the last examined word in the list
NEXT:	HLRZ	WD,SORDID(LWD)	;get pointer from LWD to next WD
	TRZ	WD,700000	;zero out length bits that were in the pointer
	JUMPE	WD,INSERT	;if null pointer, insert word at end of list
	HRRZ	FIRST,SORDID(WD);get pointer from WD to text (characters) of word
	MOVE	A,LEN		;load A with length of current word (in words)
	CAME	PART1,1(FIRST)	;method of comparison: compare first parts.
	JRST	CHECK1		;	If unequal, jump out. Otherwise, if
	AOJGE	A,INSERT	; 	there is still part of the word left,
	CAME	PART2,2(FIRST)	;	continue comparing.If the word is the
	JRST	CHECK2		;	same as an existing word, go to INSERT to
	AOJGE	A,INSERT	;	insert it again.
	CAME	PART3,3(FIRST)
	JRST	CHECK3
	AOJGE	A,INSERT
CHECK4:	CAMG	PART4,4(FIRST)	;note that we only need one CAM for the last part (PART4)
	JRST	INSERT
	JRST	ADVNCE
CHECK3:	CAMG	PART3,3(FIRST)	;if it is greater, then you want to continue checking.
	JRST	INSERT		;if it is less, you want to insert it where you are
	JRST	ADVNCE		;advance the pointers.
CHECK2:	CAMG	PART2,2(FIRST)
	JRST	INSERT
	JRST	ADVNCE
CHECK1:	CAMG	PART1,1(FIRST)
	JRST	INSERT
ADVNCE:	MOVE	LWD,WD		;the new LWD is the old WD
	JRST	NEXT		;continue down list looking for place to insert current word

;insert next word into list of previously sorted words.

INSERT:	HLRZ	A,SORDID(SORPTR);retrieve the size of current word
	ASH	A,17		;move the size to the left hand bits of AC right
	ADD	A,WD		;put the link in the low order bits of AC right
	HRLM	A,SORDID(SORPTR);store the length and link of the new word
	HLRZ	A,SORDID(LWD)	;get the length and link of LWD
	TRZ	A,77777		;zero the link
	ADD	A,SORPTR	;add in the new link
	HRLM	A,SORDID(LWD)	;store the length and new link of LWD
	ADDI	SORPTR,1	;increment SORPTR to next word not yet sorted
	JRST	BETW
;Open INDEX and DICT files.  Read in WORDS and LINKS files.

READ:	OPEN	7,DSK17		;prepare to open INDEX for writing new version
	UERROR	40	;	;OPEN FAILED ON DSK
	SETZM	INDEXF+1
	SETZM	INDEXF+2
	SETZM	INDEXF+3
	ENTER	7,INDEXF	;INDEX file
	JRST	PAUSE2		;FILER must be writing INDEX now...wait a bit

AGAIN4:	OPEN	3,DSK17		;open DICT file in Read Alter mode
	UERROR	44	;	;OPEN FAILED ON DSK
	SETZM	DICTF+3
	LOOKUP	3,DICTF
	JRST	PAUSE4
	SETZM	DICTF+1
	SETZM	DICTF+2
	SETZM	DICTF+3
	ENTER	3,DICTF
	JRST	PAUSE4
	SETZM	DICREC		;indicate that no DICT rec is in core
	SETZM	MLTREC		;indicate that no mult rec of DICT is in core
	SETOM	CATNBR
	PUSHJ	P,GTDICT

	OPEN	4,DSK17		;read in WORDS
	UERROR	50	;	;OPEN FAILED ON DSK
	SETZM	WORDSF+3
	LOOKUP	4,WORDSF
	UERROR	54	;	;LOOKUP FAILED ON FILE: WORDS
	IN	4,WCMD
	JRST	.+2
	UERROR	60	;	;IN UUO FAILED TO READ IN FILE: WORDS
	RELEAS	4,

	OPEN	5,DSK17		;read in LINKS
	UERROR	64	;	;OPEN FAILED ON DSK
	SETZM	LINKSF+3
	LOOKUP	5,LINKSF
	UERROR	70	;	;LOOKUP FAILED ON FILE: LINKS
	IN	5,LCMD
	JRST	.+2
	UERROR	74	;	;IN UUO FAILED TO READ IN FILE: LINKS
	RELEAS	5,
;Look for keywords in story.  Link up any that are found.

	SETZM	LINKS+1			;init back ptr from new story to LINKS
	SETZ	WD,			;point to header of sorted list
	MOVEI	DICTWD,2		;point to first word in dictionary
	MOVEM	DICTWD,DICPTR
NEXTWD:	TLZ	F,CATFLG		;clear the "categorized" flag
	HLRZ	WD,SORDID(WD)		;get link to next word in list
	TRZ	WD,700000		;zero out the length field
	JUMPE	WD,DONE			;a zero link means end of list
	HLRO	A,SORDID(WD)		;get length this word
	ASH	A,-17			;right adjust the length
	HRRZ	TXTPTR,SORDID(WD)	;get the pointer to the text of this word
	MOVE	PART1,1(TXTPTR)
	MOVE	PART2,2(TXTPTR)
	MOVE	PART3,3(TXTPTR)		;load the parts of this word into ACs
	MOVE	PART4,4(TXTPTR)
	SUB	TXTPTR,A		;advance TXTPTR to next consecutive word in TEXT
	CAMGE	A,[-4]
	HRREI	A,-4			;prepare to compare at most 4 parts of current word
	MOVEM	A,LEN			;save pseudo length of this word
	JRST	.+2

NXTDWD:	PUSHJ	P,RDDICT
	HLRZ	FIRST,DICT(DICTWD)	;get pointer to text of dictionary word
	MOVE	A,LEN			;put length of current word into A
	CAME	PART1,WORDS(FIRST)	;compare parts until inequality or
	JRST	CK1			;	until no more parts left in
	AOJGE	A,EQUAL			;	which case words must be equal
	CAME	PART2,WORDS+1(FIRST)
	JRST	CK2
	AOJGE	A,EQUAL
	CAME	PART3,WORDS+2(FIRST)
	JRST	CK3
	AOJGE	A,EQUAL
	CAMN	PART4,WORDS+3(FIRST)
	JRST	EQUAL

CK4:	CAMG	PART4,WORDS+3(FIRST)	;when a part is unequal, see which word is less
	JRST	NEXTWD			;Word not in dictionary
	JRST	NXTDWD			;Get next dictionary word
CK3:	CAMG	PART3,WORDS+2(FIRST)
	JRST	NEXTWD
	JRST	NXTDWD
CK2:	CAMG	PART2,WORDS+1(FIRST)
	JRST	NEXTWD
	JRST	NXTDWD
CK1:	CAMG	PART1,WORDS(FIRST)
	JRST	NEXTWD
	JRST	NXTDWD
;Link up keyword in story.

EQUAL:	HLRZ	A,DICT+1(DICTWD)	;is current dict word part of a mult key?
	JUMPE	A,CATEG			;no.  categorize current story by dict wd
	PUSH	P,MLTREC		;save record nbr of current mult key
	PUSH	P,MLTPTR
	PUSH	P,DICTWD		;save current dict word
	MOVE	DICTWD,A		;get ptr to next word in multiple key
	ADDI	WD,1			;move ptr to following word in story
	MOVE	PART1,1(TXTPTR)		;load the parts of the story word into ACs
	MOVE	PART2,2(TXTPTR)
	MOVE	PART3,3(TXTPTR)
	MOVE	PART4,4(TXTPTR)
	HLRO	A,SORDID(WD)		;get length of this story word
	ASH	A,-17			;shift length into low order bits of AC
	SUB	TXTPTR,A		;move TXTPTR to the NEXT story word
	CAMGE	A,[-4]			;compare at most 4 parts of the story
	HRREI	A,-4			;	word and the dict word
	MOVEM	A,LEN			;save pseudo length of story word
BRO:	PUSHJ	P,GETMLT		;make sure the DICT rec containing the mult is in core
	MOVE	A,LEN			;put length of story word in AC A for counting
	HLRZ	FIRST,DICT(DICTWD)	;get ptr to first part of dict wd in WORDS
	CAME	PART1,WORDS(FIRST)	;compare story word and dict word
	JRST	NOTSAM
	AOJGE	A,EQUAL			;A=0 means we are at end of story word
	CAME	PART2,WORDS+1(FIRST)
	JRST	NOTSAM
	AOJGE	A,EQUAL
	CAME	PART3,WORDS+2(FIRST)
	JRST	NOTSAM
	AOJGE	A,EQUAL
	CAMN	PART4,WORDS+2(FIRST)
	JRST	EQUAL
NOTSAM:	HRRZ	DICTWD,DICT+2(DICTWD)	;story word not same as dict wd. get ptr to
	JUMPN	DICTWD,BRO		;  mult bro. if zero, then no bro exists.
	JRST	EQ2

;categorize story by longest keyword that matched.
CATEG:	SKIPN	AVAIL,LINKS		;any slots available in LINKS file?
	JRST	EQ2			;no!!
	CAIL	DICTWD,200
	PUSHJ	P,[MOVE	A,GUDREC	;make sure correct mult rec is in core
		   JRST	CHKREC]
	HRRE	A,DICT+1(DICTWD)	;get pointer to first slot for current word
	JUMPL	A,EQ2			;is this a legal keyword?
	SKIPGE	B,CATNBR
	JRST	EQ4
	CAMN	DICTWD,KEYS(B)		;has this keyword already categorized story?
	JRST	EQ2			;yes
	SOJGE	B,.-2
EQ4:	AOS	B,CATNBR		;prepare to save ptr to keyword entry in
	CAIL	B,NKEYS			;	KEYS array to prevent duplication
	JRST	EQ2			;no more room in KEYS array. dont use keyword
	MOVEM	DICTWD,KEYS(B)		;insure that this keyword won't be used again
	TLO	F,CATFLG+WRFLAG		;set "categorized" flag & mark DICT rec as changed
	MOVE	B,LINKS(AVAIL)		;remove available slot from free slot list
	MOVEM	B,LINKS			;	and update free-slot list header
	JUMPE	A,EQ1			;a zero pointer means no such slot exists
	HRRM	AVAIL,LINKS(A)		;store back ptr to new slot in old slot
	HRLM	A,LINKS(AVAIL)		;store ptr to old slot in new slot
EQ1:	CAIL	DICTWD,200		;is this a mult word key?
	SKIPA	A,MLTPTR		;yes. get negated ptr to mult word key
	MOVN	A,DICPTR		;no. negate dictwd pointer for storing it
	HRRM	A,LINKS(AVAIL)		;store negated dict pointer in new slot
	HRRM	AVAIL,DICT+1(DICTWD)	;store ptr to new slot in dict entry for current word
	MOVE	A,LINKS+1		;get back ptr to last slot in current story
	MOVEM	A,LINKS+1(AVAIL)	;store that ptr in new slot
	MOVE	B,UNDUN			;load ptr to current story
	HRRM	B,LINKS+1(AVAIL)	;store ptr to current story in new slot
	HRLZM	AVAIL,LINKS+1		;update back ptr to last slot for story (new slot)
EQ2:	CAMN	P,INITPD		;have all multiple word entries been popped?
	JRST	NEXTWD			;yes
	POP	P,DICTWD		;no. pop next one off stack
	SUBI	WD,1			;	and readjust ptr to word in story
	POP	P,MLTPTR
	POP	P,GUDREC		;retrieve mult rec nbr for this mult key
	TLNE	F,CATFLG		;has the current keyword been categorized?
	JRST	EQ2			;yes. just pop rest of mult word entries.
	JRST	CATEG			;no. try to categorize it now.
;Write out new versions of files.

DONE:	USETO	3,@DICREC	;select the appropriate record for writing out dict
	TLNE	F,WRFLAG	;has the record of DICT that is in core been changed?
	OUT	3,DCMD		;yes.  write out the new values.
	JRST	.+2
	UBIGERR	100	;	;OUT UUO FAILED TO WRITE OUT RECORD OF DICT
	SKIPN	MLTREC		;is there a mult rec of DICT in core?
	JRST	DUN2		;no
	USETO	3,@MLTREC	;yes.  select correct rec for writing it out
	OUT	3,MCMD		;write out last mult rec that is in core
	JRST	.+2
	UBIGERR	104	;	;OUT UUO FAILED TO WRITE OUT LAST MULT REC OF DICT
DUN2:	OPEN	10,DSK17	;prepare to write out LINKS
	UERROR	110	;	;OPEN FAILED ON DSK
	SETZM	LINKSF+1
	SETZM	LINKSF+2
	SETZM	LINKSF+3
	ENTER	10,LINKSF
	UERROR	114	;	;ENTER FAILED ON FILE: LINKS
	OUT	10,LCMD		;write out LINKS file
	JRST	.+2
	UERROR	120	;	;OUT UUO FAILED TO WRITE OUT FILE: LINKS
FINISH:	MOVE	B,UNDUN		;get ptr to current (UNDUN story)
	OPEN	6,DSK17		;prepare to open INDEX for reading old version
	UERROR	124	;	;OPEN FAILED ON DSK
	SETZM	INDEXF+3
	LOOKUP	6,INDEXF	;INDEX file
	UERROR	130	;	;LOOKUP FAILED ON FILE: INDEX
	IN	6,XCMD		;read in entire INDEX file
	JRST	.+2
	UERROR	134	;	;IN UUO FAILED TO READ IN FILE: INDEX
	RELEAS	6,		;old version of INDEX that was just read
	TLNE	F,MISSIN	;should new parameters be written out for this story?
	JRST	FIN3		;no
	HLLZ	A,LINKS+1	;load back ptr to last slot for current story
	TLNE	F,TAKEFG	;is this story a take?
	HRRI	A,-1		;yes.  turn on TAKE indicator for this story
	MOVEM	A,INDEX(B)	;store back ptr and take indicator for this story
	JUMPE	PREV,FIN3	;ACs WD and PREV are the same. so if the current
	HLRZ	A,INDEX+2(PREV)	;IS PREV STORY A FOLLOW UP?
	JUMPN	A,.+2
	MOVE	A,PREV		;NO
	HRLM	A,INDEX+2(B)	;SAVE PTR TO ORIGINAL STORY
FIN1:	HRRE	A,INDEX(PREV)	;	story is to be linked up with an earlier
	JUMPLE	A,FIN2		;	one, PREV will be non-zero. if the current
	MOVE	PREV,A		;	story is not to be linked up with an
	JRST	FIN1		;	earlier story WD (PREV) will be zero
FIN2:	HRRM	A,INDEX(B)	;put whatever was in the old story's link in the new story's
	HRRM	B,INDEX(PREV)	;put a link to the new story in the old story's link
FIN3:	ADDI	B,XSIZE		;advance UNDUN
	CAIL	B,XLEN
	MOVEI	B,SPECS
	MOVEM	B,UNDUN		;put new value of UNDUN back into INDEX array
	OUT	7,XCMD		;write out new INDEX file
	JRST	.+2
	UERROR	140	;	;OUT UUO FAILED TO WRITE OUT FILE: INDEX
	RELEAS	10,		;LINKS file
	RELEAS	3,		;DICT file
	RELEAS	7,		;new version of INDEX file
	TLNE	F,MISSIN	;check if the story to have been catagorized was missing
	UBIGERR	144	;	;A STORY DISAPPEARED BEFORE BEING CATAGORIZED
;	OUTSTR	[ASCIZ / FINISHED! /]
	SKIPE	LINKS		;have we run out of slots in LINKS?
	JRST	MORE		;no
	JUMPN	PREV,MORE	;prev ≠ 0 means LINKS wasn't read in, so we are ok
	UBIGERR	150	;	;LINKS WAS READ IN AND THERE ARE NO MORE SLOTS
;Subroutines:  RDDICT, GTDICT, PAUSE1-4, DIGEST, DONTDO, GONE.

RDDICT:	SETOM	CATNBR		;indicate no similar keywords used
	MOVEI	A,2		;advance to next entry in dictionary by incrementing
	ADDM	A,DICPTR	;	DICPTR and DICTWD by 2
	ADDI	DICTWD,2
	CAIGE	DICTWD,200	;has DICTWD gone beyond the record that is in core?
	POPJ	P,		;no.  return.
	TLNN	F,WRFLAG	;has the DICT record in core been changed?
	JRST	GTDICT		;no
	USETO	3,@DICREC	;yes. select correct record for writing it out
	OUT	3,DCMD		;write out the new values.
	JRST	.+2
	UBIGERR	154	;	;OUT UUO FAILED TO WRITE OUT ONE RECORD OF DICT
GTDICT:	AOS	A,DICREC	;adjust DICREC to the new record number
	USETI	3,(A)
	IN	3,DCMD		;read in the next record
	JRST	.+2
	UBIGERR	160	;	;IN UUO FAILED TO READ IN A RECORD OF DICT
	TLZ	F,WRFLAG	;clear the write flag
	SETZ	DICTWD,		;set DICTWD to point at beginning of record
	POPJ	P,		;return

;make sure the record needed for a mult DICT entry, as indicated by DICTWD, is in core
GETMLT:	MOVE	A,DICTWD
	MOVNM	DICTWD,MLTPTR	;save negated ptr to this mult word key
	TRZ	DICTWD,777600	;zero out record part of DICTWD
	ADDI	DICTWD,200	;make DICTWD point to the mult rec of DICT in core
	ASH	A,-7		;calculate the number of the mult rec needed in core
	ADDI	A,1
CHKREC:	MOVEM	A,GUDREC
	CAMN	A,MLTREC	;is that record already in core?
	POPJ	P,		;yes
	SKIPN	MLTREC		;is any mult rec in core?
	JRST	GETM		;no
	USETO	3,@MLTREC	;yes. select the proper rec nbr for writing it back out
	OUT	3,MCMD		;write out the rec that is in core
	JRST	.+2
	UBIGERR	164	;	;OUT UUO FAILED TO WRITE OUT MULT REC OF DICT
GETM:	MOVEM	A,MLTREC	;save number of new mult rec to be in core
	USETI	3,(A)		;select the correct record to be read in
	IN	3,MCMD		;read in a new mult rec
	POPJ	P,		;return
	UBIGERR	170	;	;IN UUO FAILED TO READ IN MULT REC FROM DICT

PAUSE1:	RELEAS	0,
;	OUTSTR	[ASCIZ / PAUSE-NEWS /]
	MOVEI	A,2
	CALL	A,[SIXBIT /SLEEP/]
	JRST	AGAIN1
PAUSE2:	RELEAS	7,
;	OUTSTR	[ASCIZ / PAUSE-INDEX /]
	MOVEI	A,2
	CALL	A,[SIXBIT /SLEEP/]
	JRST	READ
PAUSE3:	RELEAS	1,
	MOVEI	A,1
	CALL	A,[SIXBIT /SLEEP/]
	JRST	AGAIN3
PAUSE4:	RELEAS	3,
	MOVEI	A,2
	CALL	A,[SIXBIT /SLEEP/]
	JRST	AGAIN4

;and now, a few kludges...
DONTDO:
DIGEST:	SETZ	PREV,		;inhibit linking this story with any earlier story
	SETOM	LINKS		;inhibit error msg about no slots in LINKS
	SETZM	LINKS+1		;clear back ptr to LINKS slots for this story
	JRST	LINKEM		;finish up

GONE:	SETOM	LINKS		;inhibit error msg about no slot in LINKS
	TLO	F,MISSIN	;set flag indicating that this story was not found
	JRST	LINKEM		;finish up
;Subroutines: UUCODE.

ECMD:	IOWD	1,BUF
	0
EMSG:	ASCIZ	/DOER  error #/]
ELEN←←.-EMSG

UUCODE:	0
	HRRZ	A,40		;get error number
	MOVE	BPTR,[POINT 7,D]
	SETZ	D,
	PUSHJ	P,NXTDG
	SETO	A,
	GETLIN	A
	AOJE	A,DET
	HLRZ	A,40
	CAIN	A,(<UBIGERR>)
	OUTSTR	[ASCIZ/SUPER /]
	CAIE	A,(<UEXIT>)	;is this a horrendous error?
	OUTSTR	[ASCIZ/HORRENDOUS /]	;yes
	OUTSTR	EMSG
	OUTSTR	D
	CALLI	1,12
	JRST	@UUCODE

DET:	CALLI	0
	HLRZ	A,40
	CAIN	A,(<UEXIT>)	;is this a horrendous error?
	JRST	DETFIN		;no.  swap in new DOER
	OPEN	1,DSK17		;yes.  write message in error file
	CALLI	12
	SETZM	ERRORF+3
	LOOKUP	1,ERRORF
	SETZM	ERRORF+3	;lookup failed.  pretend file there with 0 words
	HLRE	A,ERRORF+3	;pick up word count of error file
	SETZM	ERRORF+3
	ENTER	1,ERRORF
	JRST	DETFIN
	DPB	A,[POINT 7,ECMD,17];put -(word count mod 200) into dump mode command
	MOVN	A,A		;make word count positive
	LDB	B,[POINT 11,A,28];get record part of count
	ANDI	A,177		;get remainder
	JUMPE	A,PUTERR	;if no remainder, then dont read in anything
	USETI	1,1(B)
	IN	1,ECMD
	JRST	.+2
	CALLI	12
PUTERR:	MOVEI	C,BUF(A)
	HRLI	C,EMSG
	BLT	C,BUF+ELEN-1(A)	;put error message into block to be output
	MOVEM	D,BUF+ELEN(A)	;put ASCIZ error number into block
	MOVE	C,[ASCIZ/
/]
	MOVEM	C,BUF+ELEN+1(A)	;put crlf after error number
	MOVNI	A,ELEN+2(A)	;calculate number of words to be written out
	HRLM	A,ECMD		; and put it negated into dump mode command
	USETO	1,1(B)
	OUTPUT	1,ECMD
	RELEAS	1,
DETFIN:	SKIPE	RESTAR		;is this a restarted DOER?
	CALLI	12		;yes.  dont restart again
	HLRZ	A,40		;no
	MOVEI	B,SWAPBK
	CAIE	A,(<UBIGERR>)	;super horrendous error?
	CALLI	B,400004	;no.  swap in and start up fresh version of DOER
	CALLI	12

NXTDG:	IDIVI	A,=8		;convert number in AC A to octal ASCII string
	PUSH	P,B
	SKIPE	A
	PUSHJ	P,NXTDG
	POP	P,A
	ADDI	A,60
	IDPB	A,BPTR
	POPJ	P,
;Interrupt level module: INTRPT, CHGNAM.

INTRPT:	MOVE	A,JOBCNI
	JFFO	A,.+1
	CAIN	A+1,=19			;was it an interrupt to set the job name
	JRST	CHGNAM			;yes.  do it.
	MOVEM	A+1,SVINTR#		;save indicator of the cause of interrupt
	CALL	[SIXBIT /UWAIT/]
	JRST@	2,[.+1]			;no.  get out of user-iot.
	CALL	[SIXBIT /DEBREAK/]
	MOVE	A,SVINTR
	CAIE	A,=9			;was the interrupt for a parity error?
	UBIGERR	174	;	;UNKNOWN INTERRUPT OCCURRED
	UEXIT	200	;	;PARITY ERROR

CHGNAM:	SETZ	A,			;zero out job name
	CALL	A,[SIXBIT /SETNAM/]
	SETOM	NRDOER			;initialize indicator to one other doer
	MOVE	A,NAME
	CALL	A,[SIXBIT /NAMEIN/]
	JRST	.+2			;zero or multiple doers exist
	CALL	[SIXBIT /DISMIS/]	;exactly one other doer exists
	SETZM	NRDOER			;set indicator to multiple doers
	CAIE	A,1			;check error code of NAMEIN
	CALL	[SIXBIT /DISMIS/]	;multiple doers exist
	AOS	NRDOER			;set indicator to no other doers
	MOVE	A,NAME			;set job name
	CALL	A,[SIXBIT /SETNAM/]
	MOVEI	A,200000
	CALL	A,[SIXBIT /INTACM/]	;disable further pdl ov interrupts
	CALL	[SIXBIT /DISMIS/]

	END	DOER